home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / pheadr.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  12KB  |  353 lines
  1. /* pheadr.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     doublereal tcstar[2], tcstop[2], tcincr[2];
  42.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  43. } dc_;
  44.  
  45. #define dc_1 dc_
  46.  
  47. struct {
  48.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  49.         rstats[50];
  50.     integer iwidth, lwidth, nopage;
  51. } miscel_;
  52.  
  53. #define miscel_1 miscel_
  54.  
  55. struct {
  56.     doublereal value[200000];
  57. } blank_;
  58.  
  59. #define blank_1 blank_
  60.  
  61. /* Table of constant values */
  62.  
  63. static integer c__12 = 12;
  64. static integer c__10 = 10;
  65. static integer c__48 = 48;
  66. static integer c__1 = 1;
  67.  
  68. /*<       subroutine pheadr(aheadr) >*/
  69. /* Subroutine */ int pheadr_(aheadr)
  70. doublereal *aheadr;
  71. {
  72.     /* Initialized data */
  73.  
  74.     static struct {
  75.     char e_1[16];
  76.     doublereal e_2;
  77.     } equiv_26 = { {'t', 'i', 'm', 'e', ' ', ' ', ' ', ' ', 'f', 'r', 'e',
  78.          'q', ' ', ' ', ' ', ' '}, 0. };
  79.  
  80. #define xtype ((doublereal *)&equiv_26)
  81.  
  82.     static struct {
  83.     char e_1[8];
  84.     doublereal e_2;
  85.     } equiv_27 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  86.  
  87. #define ablnk (*(doublereal *)&equiv_27)
  88.  
  89.     static struct {
  90.     char e_1[8];
  91.     doublereal e_2;
  92.     } equiv_28 = { {'v', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  93.  
  94. #define aletv (*(doublereal *)&equiv_28)
  95.  
  96.     static struct {
  97.     char e_1[8];
  98.     doublereal e_2;
  99.     } equiv_29 = { {'i', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  100.  
  101. #define aleti (*(doublereal *)&equiv_29)
  102.  
  103.  
  104.     /* System generated locals */
  105.     integer i_1;
  106.  
  107.     /* Local variables */
  108.     static doublereal anam;
  109.     static integer info, locv, iknt;
  110.     extern /* Subroutine */ int move_();
  111.     static integer ipos, nwds, ityp;
  112.     extern /* Subroutine */ int getm4_();
  113.     static integer iseq2;
  114.     extern /* Subroutine */ int getm8_(), copy8_();
  115.     static integer i, ibuff, iseqs;
  116. #define nodpl2 ((integer *)&blank_1)
  117.     static integer itype2;
  118. #define nodplc ((integer *)&blank_1)
  119. #define cvalue ((complex *)&blank_1)
  120.     extern /* Subroutine */ int fwrite_();
  121.     static integer numout, inames, itypes;
  122.     extern /* Subroutine */ int alfnum_(), clrmem_();
  123.     static integer loc, int2, int3;
  124.  
  125.     /* Parameter adjustments */
  126.     --aheadr;
  127.  
  128.     /* Function Body */
  129. /*<       implicit double precision (a-h,o-z) >*/
  130. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  131. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  132. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  133. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  134. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  135. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  136. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  137. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  138. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  139. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  140. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  141. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  142. /* spice version 2g.6  sccsid=status 3/15/83 */
  143. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  144. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  145. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  146. /* spice version 2g.6  sccsid=dc 3/15/83 */
  147. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  148. /*<      1   kinel,kidin,kovar,kidout >*/
  149. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  150. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  151. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  152. /* spice version 2g.6  sccsid=blank 3/15/83 */
  153. /*<       common /blank/ value(200000) >*/
  154. /*<       integer nodplc(64) >*/
  155. /*<       complex cvalue(32) >*/
  156. /* int3 (not used) is strictly for alignment.  f77 on unix craps out. */
  157. /*<       integer int2,int3,nodpl2(128) >*/
  158. /*<       equivalence (value(1),nodpl2(1)) >*/
  159. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  160. /*<       dimension aheadr(10) >*/
  161.  
  162. /*  put out the header records onto the post-processing file */
  163. /*  routine is used for all analysis modes (mode=1,2,3) */
  164.  
  165. /*<       dimension xtype(2) >*/
  166. /*<       data xtype /4htime,4hfreq/ >*/
  167. /*<       data ablnk,aletv,aleti /1h ,1hv,1hi/ >*/
  168.  
  169. /* file structure for post-processor */
  170.  
  171. /*record 1  title card (80 bytes), date (8 bytes), time (8 bytes) 
  172. total-96 bytes*/
  173. /* record 2  number of output variables (including "sweep" variable) */
  174. /* record 3  integer '4' (2 bytes) */
  175. /* record 4  names of each output variable (8 bytes ea.) */
  176. /* record 5  type of each output       0-no type */
  177. /*                                     1-time */
  178. /*                                     2-frequency */
  179. /*                                     3-voltage */
  180. /*                                     4-current */
  181. /*                                     5-output noise */
  182. /*                                     6-input noise */
  183. /*                                     7-hd2    | */
  184. /*                                     8-hd3    | */
  185. /*                                     9-dim2   }   distortion outputs */
  186. /*                                    10-sim2   | */
  187. /*                                    11-dim3   | */
  188. /* record 6  the location of each variable within each sweep point. */
  189. /*          (normally just 1,2,3,4,... but needed if outputs are mixed up)
  190. */
  191. /* record 6a 24 characters that are the plot title if record 3 is a '4'. 
  192. */
  193. /* record 7  output at first sweep point */
  194. /* record 8  output at second sweep point */
  195. /* record 9  . */
  196. /*           . */
  197. /*           . */
  198. /* last record */
  199.  
  200.  
  201. /*<       call getm8(ibuff,12) >*/
  202.     getm8_(&ibuff, &c__12);
  203. /*<       call copy8(aheadr(1),value(ibuff+1),10) >*/
  204.     copy8_(&aheadr[1], &blank_1.value[ibuff], &c__10);
  205. /*<       value(ibuff+11)=adate >*/
  206.     blank_1.value[ibuff + 10] = miscel_1.adate;
  207. /*<       value(ibuff+12)=atime >*/
  208.     blank_1.value[ibuff + 11] = miscel_1.atime;
  209. /*<       call fwrite(value(ibuff+1),48) >*/
  210.     fwrite_(&blank_1.value[ibuff], &c__48);
  211. /*<       numout=nunods+jelcnt(9) >*/
  212.     numout = cirdat_1.nunods + cirdat_1.jelcnt[8];
  213. /* force nused to be allocated by useless usage. */
  214. /*<       int2 = numout >*/
  215.     int2 = numout;
  216. /*<       int3 = numout >*/
  217.     int3 = numout;
  218. /*<       info=4 >*/
  219.     info = 4;
  220. /*<       call getm8(inames,numout) >*/
  221.     getm8_(&inames, &numout);
  222. /*<       call getm4(itypes,numout) >*/
  223.     getm4_(&itypes, &numout);
  224. /*<       call getm4(iseqs,numout) >*/
  225.     getm4_(&iseqs, &numout);
  226. /*<       itype2=itypes*2 >*/
  227.     itype2 = itypes << 1;
  228. /*<       iseq2=iseqs*2 >*/
  229.     iseq2 = iseqs << 1;
  230. /*<       iknt=1 >*/
  231.     iknt = 1;
  232. /*<       nodpl2(iseq2+1)=1 >*/
  233.     nodpl2[iseq2] = 1;
  234.  
  235. /* dc transfer curve (mode = 1): */
  236.  
  237. /*<       if(mode.ne.1) go to 10 >*/
  238.     if (status_1.mode != 1) {
  239.     goto L10;
  240.     }
  241. /*<       loc=itcelm(1) >*/
  242.     loc = dc_1.itcelm[0];
  243. /*<       locv=nodplc(loc+1) >*/
  244.     locv = nodplc[loc];
  245. /*<       value(inames+1)=value(locv) >*/
  246.     blank_1.value[inames] = blank_1.value[locv - 1];
  247. /*<       anam=ablnk >*/
  248.     anam = ablnk;
  249. /*<       call move(anam,1,value(locv),1,1) >*/
  250.     move_(&anam, &c__1, &blank_1.value[locv - 1], &c__1, &c__1);
  251. /*<       ityp=0 >*/
  252.     ityp = 0;
  253. /* voltage transfer becomes type 3 and current transfer becomes 4. */
  254. /*<       if(anam.eq.aletv) ityp=3 >*/
  255.     if (anam == aletv) {
  256.     ityp = 3;
  257.     }
  258. /*<       if(anam.eq.aleti) ityp=4 >*/
  259.     if (anam == aleti) {
  260.     ityp = 4;
  261.     }
  262. /*<       nodpl2(itype2+1)=ityp >*/
  263.     nodpl2[itype2] = ityp;
  264. /*<       go to 20 >*/
  265.     goto L20;
  266. /*<    10 value(inames+1)=xtype(mode-1) >*/
  267. L10:
  268.     blank_1.value[inames] = xtype[status_1.mode - 2];
  269. /*<       nodpl2(itype2+1)=mode-1 >*/
  270.     nodpl2[itype2] = status_1.mode - 1;
  271. /*<    20 do 30 i=2,nunods >*/
  272. L20:
  273.     i_1 = cirdat_1.nunods;
  274.     for (i = 2; i <= i_1; ++i) {
  275. /*<       nodpl2(itype2+i)=3 >*/
  276.     nodpl2[itype2 + i - 1] = 3;
  277. /*<       nodpl2(iseq2+i)=i >*/
  278.     nodpl2[iseq2 + i - 1] = i;
  279. /*<       value(inames+i)=ablnk >*/
  280.     blank_1.value[inames + i - 1] = ablnk;
  281. /*<       ipos=1 >*/
  282.     ipos = 1;
  283. /*<       call alfnum(nodplc(junode+i),value(inames+i),ipos) >*/
  284.     alfnum_(&nodplc[tabinf_1.junode + i - 1], &blank_1.value[inames + i - 
  285.         1], &ipos);
  286. /*<    30 continue >*/
  287. /* L30: */
  288.     }
  289. /*<       loc=locate(9) >*/
  290.     loc = cirdat_1.locate[8];
  291. /*<       iknt=nunods >*/
  292.     iknt = cirdat_1.nunods;
  293. /*<    40 if(loc.eq.0) go to 50 >*/
  294. L40:
  295.     if (loc == 0) {
  296.     goto L50;
  297.     }
  298. /*<       iknt=iknt+1 >*/
  299.     ++iknt;
  300. /*<       nodpl2(itype2+iknt)=4 >*/
  301.     nodpl2[itype2 + iknt - 1] = 4;
  302. /*<       nodpl2(iseq2+iknt)=iknt >*/
  303.     nodpl2[iseq2 + iknt - 1] = iknt;
  304. /*<       locv=nodplc(loc+1) >*/
  305.     locv = nodplc[loc];
  306. /*<       value(inames+iknt)=value(locv) >*/
  307.     blank_1.value[inames + iknt - 1] = blank_1.value[locv - 1];
  308. /*<       loc=nodplc(loc) >*/
  309.     loc = nodplc[loc - 1];
  310. /*<       go to 40 >*/
  311.     goto L40;
  312. /*<    50 int2=numout >*/
  313. L50:
  314.     int2 = numout;
  315. /*<       call fwrite(int2,1) >*/
  316.     fwrite_(&int2, &c__1);
  317. /*<       int2=info >*/
  318.     int2 = info;
  319. /*<       call fwrite(int2,1) >*/
  320.     fwrite_(&int2, &c__1);
  321. /*<       nwds=numout*4 >*/
  322.     nwds = numout << 2;
  323. /*<       call fwrite(value(inames+1),nwds) >*/
  324.     fwrite_(&blank_1.value[inames], &nwds);
  325. /*<       call fwrite(nodpl2(itype2+1),numout) >*/
  326.     fwrite_(&nodpl2[itype2], &numout);
  327. /*<       call fwrite(nodpl2(iseq2+1),numout) >*/
  328.     fwrite_(&nodpl2[iseq2], &numout);
  329. /*<       call fwrite(aprog(1),12) >*/
  330.     fwrite_(miscel_1.aprog, &c__12);
  331. /*<       call clrmem(ibuff) >*/
  332.     clrmem_(&ibuff);
  333. /*<       call clrmem(inames) >*/
  334.     clrmem_(&inames);
  335. /*<       call clrmem(itypes) >*/
  336.     clrmem_(&itypes);
  337. /*<       call clrmem(iseqs) >*/
  338.     clrmem_(&iseqs);
  339. /*<       return >*/
  340.     return 0;
  341. /*<       end >*/
  342. } /* pheadr_ */
  343.  
  344. #undef cvalue
  345. #undef nodplc
  346. #undef nodpl2
  347. #undef aleti
  348. #undef aletv
  349. #undef ablnk
  350. #undef xtype
  351.  
  352.  
  353.